home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 8 / Power CD-ROM 8.iso / prgmming / pmd110 / tdinfo.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-13  |  40KB  |  652 lines
  1. (* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created :
  3.  
  4. Interfacing unit to the Borland Debug Info appended to .exe files. With thanks
  5. to Andy McFarland
  6.  
  7. Last changes :
  8. 93-12-04  Renamed TObjectClass to TClass
  9.           Moved GetLogicalAddr to BBUtil
  10. 93-12-11  Modules with no debug info (i.e. correlation records) broke
  11.           TDInfo. Now fixed.
  12. }
  13.  
  14.  
  15.  
  16. {$IFDEF DPMI}
  17. {$S-}
  18. {$ENDIF}
  19.  
  20. {$IFDEF MsDos}
  21. {$F+,O+}
  22. {$ENDIF}
  23.  
  24. {$X+,R-,Q-,N+}
  25. unit TDInfo;
  26.  
  27. interface
  28.  
  29. uses Objects, BBObject,
  30.      ObjMemory;
  31.  
  32.  
  33. const
  34.   SmallDebugHeaderSize = 48;      { size of debug header without extensions }
  35.  
  36. type
  37.   TDebugHeader = record
  38.     MagicNumber : word;           { To be sure who we are ($52FB) }
  39.     MinorVersion : byte;          { in case we change things }
  40.     MajorVersion : byte;
  41.     NamesPoolSize : longint;      { names pool size in bytes }
  42.     NamesCount : word;            { number of names in pool }
  43.     TypesCount : word;            { number f type entries }
  44.     MembersCount : word;          { structure members table }
  45.     SymbolsCount : word;          { number of symbols }
  46.     GlobalsCount : word;          { number of global symbols }
  47.     ModulesCount : word;          { number of modules (units) }
  48.     LocalsCount : word;           { optional; can be filler }
  49.     ScopesCount : word;           { number of scopes in table }
  50.     LineNumbersCount : word;      { number of line numbers }
  51.     SourceFilesCount : word;      { number of include files }
  52.     SegmentsCount : word;         { number of segment records }
  53.     CorrelationsCount : word;     { number of segment/file correlations }
  54.     ImageSize : longint;          { the number of bytes in the .EXE file }
  55.                                   { if the uninitialized part of the data }
  56.                                   { plus this debug info were removed; }
  57.                                   { always zero in Pascal debug info }
  58.     DebuggerHook : pointer;       { a far ptr into debugged program }
  59.                                   { meaning depends on program flags. For }
  60.                                   { pascal overlays, is ptr to start of }
  61.                                   { data area that contains info about }
  62.                                   { the overlays }
  63.     ProgramFlags : byte;          { a byte of flags }
  64.                                   { $00 = case sensitive link }
  65.                                   { $01 = case insensitive link }
  66.                                   { $02 = pascal overlay program }
  67.     StringSegOffse : integer;     { no longer used }
  68.     DataCount : word;             { size in bytes of data pool }
  69.     Filler1 : byte;               { to force alignment }
  70.     ExtensionSize : integer;      { 0, 16, or 32 for now }
  71.     ClassEntries,                 { number of classes }
  72.     ParentEntries,
  73.     GlobalEntries,
  74.     GlobalClasses,
  75.     OVerloadEntries,
  76.     ScopeClassEntries,
  77.     ModuleClassEntries,
  78.     CoverageOffsetCount : word;
  79.     NamePoolOffset : longint;          { offse to start of name pool. This}
  80.                                        { is relative to the symbols base }
  81.     BrowsersCount,                     { number of browser info recs }
  82.     OptSymEntries,                     { number of optional symbol records }
  83.     DebugFlags : word;                 { various flags }
  84.     Filler2 : array[1..8] of byte;     { padding }
  85.   end;
  86.  
  87.  
  88. const
  89.   scStatic = 0;
  90.   scAbsolute = 1;
  91.   scLocal = 2;                         { defined as sc_Auto in OAHfP }
  92.   scPasvar = 3;
  93.   stRegister = 4;
  94.   scConst = 5;
  95.   scTypeDef = 6;
  96.   scTag = 7;
  97.  
  98. const
  99.   tid_void          = $00;             { Unknown or no type }
  100.   tid_lstr          = $01;             { Basic literal string }
  101.   tid_dstr          = $02;             { Basic dynamic string }
  102.   tid_pstr          = $03;             { Pascal style string }
  103.   tid_sChar         = $04;             { Shortint }
  104.   tid_sInt          = $05;             { Integer }
  105.   tid_sLong         = $06;             { Longint }
  106.   tid_uChar         = $08;             { Byte }
  107.   tid_uInt          = $09;             { Word }
  108.   tid_PChar         = $0C;             { Char }
  109.   tid_Float         = $0D;             { IEEE 32-bit real }
  110.   tid_Tpreal        = $0E;             { Turbo Pascal 6-byte real }
  111.   tid_Double        = $0F;             { IEEE 64-bit real }
  112.   tid_Ldouble       = $10;             { IEEE 80-bit real }
  113.   tid_BCD4          = $11;             { 4 byte BCD }
  114.   tid_BCD8          = $12;             { 8 byte BCD }
  115.   tid_BCD10         = $13;             { 10 byte BCD }
  116.   tid_BCDCOB        = $14;             { COBOL BCD }
  117.   tid_Near          = $15;             { Near pointer }
  118.   tid_Far           = $16;             { Far pointer }
  119.   tid_Seg           = $17;             { Segment pointer }
  120.   tid_Near386       = $18;             { 386 32-bit offset ptr }
  121.   tid_Far386        = $19;             { 386 48-bit far ptr }
  122.   tid_Parray        = $1C;             { Pascal array }
  123.   tid_Struct        = $1E;             { Structure }
  124.   tid_Union         = $1F;             { Union }
  125.   tid_ENUM          = $22;             { Enumerated type }
  126.   tid_Function      = $23;             { Function or procedure }
  127.   tid_Label         = $24;             { Goto label }
  128.   tid_SET           = $25;             { Pascal set }
  129.   tid_Tfile         = $26;             { Pascal text file }
  130.   tid_Bfile         = $27;             { Pascal binary file }
  131.   tid_Bool          = $28;             { Pascal boolean }
  132.   tid_Penum         = $29;             { Pascal enum }
  133.   tid_FuncPrototype = $2C;             { Function with full parameter }
  134.                                        { information }
  135.   tid_SpecialFunc   = $2D;             { Special function for methods and }
  136.                                        { duplicate functions }
  137.   tid_Object        = $2E;             { Object }
  138.   tid_Nref          = $34;             { near reference pointer }
  139.   tid_Fref          = $35;             { far reference pointer }
  140.   tid_WordBool      = $36;             { Pascal word boolean }
  141.   tid_LongBool      = $37;             { Pascal long boolean }
  142.   tid_GlobalHandle  = $3E;             { Windows gloal handle }
  143.   tid_LocalHandle   = $3F;             { Windows local handle }
  144.  
  145. { we use variables instead of real constants, because we don't have to think
  146.   about doing type conversions when multiplying integers }
  147. const
  148.    SymbolRecordSize:longint = 9;
  149.    ModuleRecordSize:longint = 16;
  150.    SourceFileRecordSize:longint = 6;
  151.    LineNumberRecordSize:longint = 4;
  152.    ScopeRecordSize:longint = 12;
  153.    SegmentRecordSize:longint = 16;
  154.    CorrelationRecordSize:longint = 8;
  155.    TypeRecordSize:longint = 8;
  156.    MemberRecordSize:longint = 5;
  157.    ClassRecordSize:longint = 11;
  158.    ParentRecordSize:longint = 2;
  159.    OverloadRecordSize:longint = 8;
  160.    ScopeClassRecordSize:longint = 4;
  161.    ModuleClassRecordSize:longint = 4;
  162.    BrowserRecordSize:longint = 6;
  163.  
  164. type
  165. {* pointer types *}
  166.   PSymbol = ^TSymbol;
  167.   PModule = ^TModule;
  168.   PSourceFile = ^TSourceFile;
  169.   PLineNumber = ^TLineNumber;
  170.   PScope = ^TScope;
  171.   PSegment = ^TSegment;
  172.   PCorrelation = ^TCorrelation;
  173.   PType = ^TType;
  174.   PMember = ^TMember;
  175.   PClass = ^TClass;
  176.   PBrowser = ^TBrowser;
  177.  
  178.  
  179. {* objects *}
  180.   TSymbol = object(TObject)
  181.     Name : word;
  182.     TypeIndex : word;
  183.     Offset : word;
  184.     Segment : word;
  185.     Info : byte;
  186.     Index : word;
  187.     ModulePtr : PModule;
  188.     ScopePtr : PScope;
  189.     TypePtr : PType;
  190.     constructor Init(AIndex : word);
  191.     destructor Done;  virtual;
  192.     constructor AtAddr(Addr : pointer);
  193.     constructor AtSegment(ASegment : PSegment; Addr : pointer);
  194.     procedure Get(AIndex : word);
  195.     function  Class : word;
  196.     function  HasValidBP : Boolean;
  197.     function  ReturnAddressWordOffset : word;
  198.     function  ItsModule : PModule;
  199.     function  ItsName : string;
  200.     function  ItsScope : PScope;
  201.     function  ItsType : PType;
  202.     function  ItsValueStr(StackFrame : word) : string;
  203.     function  IsProcedure : Boolean;
  204.   end;
  205.  
  206.   TModule = object(TObject)
  207.     Name : word;
  208.     Language : byte;
  209.     Flags : byte;
  210.     SymbolIndex : word;
  211.     SymbolCount : word;
  212.     SourceFileIndex : word;
  213.     SourceFileCount : word;
  214.     CorrelationIndex : word;
  215.     CorrelationCount : word;
  216.     Index : word;
  217.     constructor Init(AIndex : word);
  218.     procedure Get(AIndex : word);
  219.     function MemoryModel : word;
  220.     function  ItsName : string;
  221.     procedure ForEachDSegElement(Action : pointer);
  222.   end;
  223.  
  224.   TSourceFile = object(TObject)
  225.     Name : word;
  226.     TimeStamp : longint;
  227.     Index : word;
  228.     constructor Init(AIndex : word);
  229.     procedure Get(AIndex : word);
  230.     function  ItsName : string;
  231.   end;
  232.  
  233.   TLineNumber = object(TObject)
  234.     Value : word;
  235.     Offset : word;
  236.     CorrelationPtr : PCorrelation;
  237.     Index : word;
  238.     constructor Init(AIndex : word);
  239.     destructor Done;  virtual;
  240.     constructor AtAddr(Addr : pointer);
  241.     procedure Get(AIndex : word);
  242.     function  ItsCorrelation : PCorrelation;
  243.   end;
  244.  
  245.   TScope = object(TObject)
  246.     SymbolIndex : word;
  247.     SymbolCount : word;
  248.     Parent : word;
  249.     FunctionSymbol : word;
  250.     Offset : word;
  251.     Length : word;
  252.     Index : word;
  253.     constructor Init(AIndex : word);
  254.     procedure Get(AIndex : word);
  255.     procedure ForEach(Action : pointer);
  256.     procedure ForEachParameter(Action : pointer);
  257.     procedure ForEachLocal(Action : pointer);
  258.   end;
  259.  
  260.   TSegment = object(TObject)
  261.     ModuleIndex : word;
  262.     CodeSegment : word;
  263.     CodeOffset : word;
  264.     CodeLength : word;
  265.     ScopeIndex : word;
  266.     ScopeCount : word;
  267.     CorrelationIndex : word;
  268.     CorrelationCount : word;
  269.     Index : word;
  270.     ModulePtr : PModule;
  271.     constructor Init(AIndex : word);
  272.     destructor Done;  virtual;
  273.     constructor AtAddr(Addr : pointer);
  274.     procedure Get(AIndex : word);
  275.     function ItsModule : PModule;
  276.     function FirstCorrelationThat(Test : pointer) : PCorrelation;
  277.     function FirstScopeThat(Test : pointer) : PScope;
  278.   end;
  279.  
  280.   TCorrelation = object(TObject)
  281.     SegmentIndex : word;
  282.     SourceFileIndex : word;
  283.     LineNumberIndex : word;
  284.     LineNumberCount : word;
  285.     Index : word;
  286.     ModulePtr : PModule;
  287.     SegmentPtr : PSegment;
  288.     SourceFilePtr : PSourceFile;
  289.     constructor Init(AIndex : word);
  290.     destructor Done;  virtual;
  291.     procedure Get(AIndex : word);
  292.     function  ItsModule : PModule;
  293.     function  ItsSegment : PSegment;
  294.     function  ItsSourceFile : PSourceFile;
  295.     function  SearchLineNumberOffset(Offset : word; var AIndex : word) : Boolean;
  296.   end;
  297.  
  298.   TType = object(TObject)
  299.     ID : byte;                         { the tid byte }
  300.     Name : word;                       { any associated type name }
  301.     Size : word;                       { the size of any object of this type }
  302.     Filler : array[1..3+8] of byte;
  303.     Index : word;
  304.     ClassTypePtr : PType;
  305.     MemberPtr : PMember;
  306.     ReturnTypePtr : PType;
  307.     constructor Init(AIndex : word);
  308.     destructor Done;  virtual;
  309.     function  max_size : byte;
  310.     function  enum_parent : word;
  311.     function  enum_lower : word;
  312.     function  enum_upper : word;
  313.     function  enum_members : word;
  314.     procedure Get(AIndex : word);
  315.     function  ItsClassType : PType;
  316.     function  ItsName : string;
  317.     function  ItsObject : PClass;
  318.     function  ItsReturnType : PType;
  319.     function  ItsValueStr(Addr : pointer) : string;
  320.     function  Member(MemberIndex : word) : PMember;
  321.     function  ReturnType : word;
  322.   end;
  323.  
  324.   TMember = object(TObject)
  325.     Info : byte;
  326.     Name : word;                       { index of the name }
  327.     Value : word;                      { value of the corresponding name }
  328.     Index : word;
  329.     ItsTypePtr : PType;
  330.     constructor Init(AIndex :word);
  331.     destructor Done;  virtual;
  332.     function  EndOfStructure : Boolean;
  333.     procedure Get(AIndex : word);
  334.     function ItsName : string;
  335.     function ItsType : PType;
  336.   end;
  337.  
  338.   TClass = object(TObject)
  339.     ParentIndex : word;                { index into parent table }
  340.     ParentCount : word;
  341.     MemberIndex : word;
  342.     Name : word;                       { tag }
  343.     VirtualPtr : word;                 { offset from top of class data }
  344.                                        { of virutal ptr }
  345.     Info : byte;                       { bit-mapped field }
  346.     Index : word;
  347.     constructor Init(AIndex :word);
  348.     procedure ForEachMember(Action : pointer);
  349.     procedure Get(AIndex : word);
  350.     function ItsName : string;
  351.   end;
  352.  
  353.   TParent = record
  354.     ClassIndex : word;                 { index into class table }
  355.   end;
  356.  
  357.   TOverload= record
  358.     FileIndex : word;
  359.     SourceLine : word;
  360.     LineOffset : word;
  361.     NameIndex : word;                  { name index to mangled name }
  362.   end;
  363.  
  364.   TScopeClass = record
  365.     ClassIndex,                        { index into class table }
  366.     ClassCount : word;                 { number of classe }
  367.   end;
  368.  
  369.   TModuleClass = record                { local classes }
  370.     ClassIndex,                        { index into class table }
  371.     ClassCount : word;                 { number of classes }
  372.   end;
  373.  
  374.   TBrowser = object(TObject)
  375.     SymbolIndex : word;                { the index of the symbol in the }
  376.                                        { Symbols table }
  377.     SourceFileIndex : word;            { which file the symbol is in }
  378.     LineNumberIndex : word;            { line number in the file }
  379.     Index : word;
  380.     LineNumberPtr : PLineNumber;
  381.     SourceFilePtr : PSourceFile;
  382.     SymbolPtr : PSymbol;
  383.     constructor Init(AIndex : word);
  384.     procedure Get(AIndex : word);
  385.     function  ItsLineNumber : PLineNumber;
  386.     function  ItsSourceFile : PSourceFile;
  387.     function  ItsSymbol : PSymbol;
  388.   end;
  389.  
  390.  
  391. type
  392.   PNames = ^TNames;
  393.   TNames = object(TObject)
  394.     arPool : PObjMemory;
  395.     arIndex : PObjMemory;
  396.     PoolOffset : longint;
  397.     CurrentIndex : longint;
  398.     constructor Init(PoolSize : longint; NamesCount : word);
  399.     destructor Done;  virtual;
  400.     procedure Add(Index : word; const s : string);
  401.     function  GetName(Index : word) : string;
  402.   end;
  403.  
  404.  
  405. {* variables should be initialized with a call to TDInfoPresent *}
  406. var
  407.   DebugHeader : TDebugHeader;
  408.   DebugInfoStart : longint;
  409.   SymbolsOffset : longint;
  410.   ModulesOffset : longint;
  411.   SourceFilesOffset : longint;
  412.   LineNumbersOffset : longint;
  413.   ScopesOffset : longint;
  414.   SegmentsOffset : longint;
  415.   CorrelationsOffset : longint;
  416.   TypesOffset : longint;
  417.   MembersOffset : longint;
  418.   ClassesOffset : longint;
  419.   ParentsOffset : longint;
  420.   ScopeClassesOffset : longint;
  421.   ModuleClassesOffset : longint;
  422.   BrowsersOffset : longint;
  423.   DataOffset : longint;
  424.   NamesOffset : longint;
  425.  
  426. const
  427.   DStream : PStream = nil;
  428.   Names : PNames = nil;
  429.  
  430.  
  431. {* initialize unit *}
  432.  
  433. function TDInfoPresent(Stream : PStream) : Boolean;
  434.  
  435.  
  436.  
  437.  IMPLEMENTATION USES {$IFDEF Windows}STRINGS , WINDOS , {$ELSE}DOS , {$ENDIF}BBERROR , BBFILE , BBUTIL ;
  438. CONSTRUCTOR TNAMES.INIT (POOLSIZE:LONGINT;NAMESCOUNT:WORD);BEGIN INHERITED INIT;ARPOOL := GETOBJMEMORY (POOLSIZE , 0 ,
  439. MEMFALL );ARINDEX := GETOBJMEMORY (LONGMUL (NAMESCOUNT , SIZEOF (LONGINT )), SIZEOF (LONGINT ), MEMFALL );IF (ARPOOL =NIL
  440. )OR (ARINDEX =NIL )THEN FAIL ;END ;DESTRUCTOR TNAMES.DONE ;BEGIN DISCARD (ARINDEX );DISCARD (ARPOOL );INHERITED DONE;
  441. END ;PROCEDURE TNAMES.ADD (INDEX:WORD;CONST S:STRING );BEGIN ARPOOL ^. MOVEFROM (S [ 1 ] , POOLOFFSET , LENGTH (S ));
  442. ARINDEX ^. RECMOVEFROM (POOLOFFSET , CURRENTINDEX );INC (CURRENTINDEX );INC (POOLOFFSET , LENGTH (S ));END ;
  443. FUNCTION TNAMES.GETNAME (INDEX:WORD):STRING ;VAR OO1O:STRING ;OI1OO00011O1,OI1OO00l1lII:LONGINT;BEGIN IF (INDEX =0 )OR
  444. (INDEX > DEBUGHEADER.NAMESCOUNT )THEN GETNAME := 'Index '+ STRW (INDEX )+ ' is invalid -- TNames.GetName --'ELSE
  445. BEGIN ARINDEX ^. RECMOVETO (INDEX - 1 , OI1OO00011O1 );IF INDEX =CURRENTINDEX THEN OI1OO00l1lII := POOLOFFSET ELSE
  446. ARINDEX ^. RECMOVETO (INDEX , OI1OO00l1lII );OO1O [ 0 ] := CHR (OI1OO00l1lII - OI1OO00011O1 );ARPOOL ^. MOVETO
  447. (OI1OO00011O1 , LENGTH (OO1O ), OO1O [ 1 ] );GETNAME := OO1O ;END ;END ;FUNCTION TDINFOPRESENT (STREAM:PSTREAM):BOOLEAN ;
  448. TYPE OOO0OlI101=(UNKNOWN, PRESENT, NOTPRESENT);CONST O10O01011010O:OOO0OlI101=UNKNOWN;FUNCTION O1OO1I1Il00l :BOOLEAN ;
  449. CONST O1lO01OlI1lO=512 ;VAR OO10:WORD;OIlO:WORD;OO1O:STRING ;OIOllI0O1OI,OI1OIIIl0lO1:LONGINT;O1010O1II0I01:WORD;
  450. OOlIll0O0lll:ARRAY [ 1 .. O1lO01OlI1lO]  OF CHAR;O10OIIlIlIlO1:WORD;BEGIN O1OO1I1Il00l := FALSE ;
  451. WITH DEBUGHEADER DO BEGIN NAMES := NEW (PNAMES , INIT (NAMESPOOLSIZE , NAMESCOUNT ));IF NAMES =NIL THEN EXIT ;DSTREAM ^.
  452. SEEK (NAMESOFFSET );OI1OIIIl0lO1 := DSTREAM ^. GETSIZE ;OIlO := 0 ;WHILE OIlO < NAMESCOUNT  DO BEGIN OIOllI0O1OI :=
  453. DSTREAM ^. GETPOS ;IF OIOllI0O1OI + O1lO01OlI1lO >= OI1OIIIl0lO1 THEN O1010O1II0I01 := OI1OIIIl0lO1 - OIOllI0O1OI ELSE
  454. O1010O1II0I01 := O1lO01OlI1lO ;DSTREAM ^. READ (OOlIll0O0lll , O1010O1II0I01 );O10OIIlIlIlO1 := 1 ;REPEAT OO10 := SCANB
  455. (@ OOlIll0O0lll [ O10OIIlIlIlO1 ] , O1lO01OlI1lO - O10OIIlIlIlO1 + 1 , 0 );IF OO10 =0 THEN BREAK ;MOVE (OOlIll0O0lll [
  456. O10OIIlIlIlO1 ] , OO1O [ 1 ] , OO10 - 1 );OO1O [ 0 ] := CHR (OO10 - 1 );NAMES ^. ADD (OIlO , OO1O );INC (OIlO );INC
  457. (O10OIIlIlIlO1 , OO10 );UNTIL (O10OIIlIlIlO1 >= O1lO01OlI1lO )OR (OIlO =NAMESCOUNT );DSTREAM ^. SEEK (OIOllI0O1OI +
  458. O10OIIlIlIlO1 - 1 );END ;DSTREAM ^. RESET ;END ;O1OO1I1Il00l := TRUE ;END ;TYPE O10110ll11II1=RECORD O101l00011OO1:WORD;
  459. Ol011l01O1:WORD;OI1lIOOl0l:WORD;O101l1011IOOO:WORD;O101l00lIl0:WORD;OOIOO1l0OIlO:WORD;O101l1I01OlI1:WORD;
  460. O1011IO0Ol0OI:WORD;O1l11I0OlO:WORD;O1OOI11OIl1O:WORD;O1l0101OIIl1:WORD;OI0lO00ll0l1:ARRAY [ 1 .. 30 ]  OF BYTE;
  461. O10111011IIll:WORD;END ;OOI11lO00lO0=RECORD OlOO1OI0I1:WORD;CASE INTEGER  OF 0 :(O101O1O1l00l1:WORD;O1010l0O10O11:WORD;
  462. O100l0Ol0I01I:WORD);1 :(OOIlO11O1100:WORD;OOO0O110l0OI:LONGINT);END ;VAR OIOIOOI0OO1,OIOOlO1I0l1:BOOLEAN;
  463. OOlIlOl0l0l1:OOI11lO00lO0;O10110OOOl1ll:O10110ll11II1;VAR OOIIlI0I1lI0:LONGINT;O101l00l1Ol10:LONGINT;
  464. {$IFDEF Windows}OIlI1OlO00I:ARRAY [ 0 .. 127 ]  OF CHAR;{$ENDIF}BEGIN TDINFOPRESENT := FALSE ;IF O10O01011010O <> UNKNOWN
  465. THEN BEGIN TDINFOPRESENT := O10O01011010O =PRESENT ;EXIT ;END ;IF STREAM =NIL THEN BEGIN {$IFDEF Windows}DSTREAM := NEW
  466. (PBUFSTREAM , INIT (STRPCOPY (OIlI1OlO00I , PARAMSTR (0 )), STOPEN + FMDENYNONE , 512 ));{$ELSE}DSTREAM := NEW
  467. (PBUFSTREAM , INIT (PARAMSTR (0 ), STOPEN + FMDENYNONE , 512 ));{$ENDIF}IF (DSTREAM =NIL )OR (DSTREAM ^. STATUS <> STOK
  468. )THEN BEGIN IF DSTREAM <> NIL THEN BEGIN LOGERROR ('Could not open executable. Status = '+ STRW (DSTREAM ^. STATUS )+
  469. ', '+ 'ErrorInfo = '+ STRI (DSTREAM ^. ERRORINFO )+ '.');IF (DSTREAM ^. STATUS =STINITERROR )AND (DSTREAM ^. ERRORINFO =4
  470. )THEN LOGERROR ('Probably too many open files.');DISCARD (DSTREAM );END ;EXIT ;END ;END ELSE DSTREAM := STREAM ;
  471. O101l00l1Ol10 := DSTREAM ^. GETPOS ;OIOIOOI0OO1 := FALSE ;REPEAT OIOOlO1I0l1 := TRUE ;IF O101l00l1Ol10 <= DSTREAM ^.
  472. GETSIZE - SIZEOF (OOI11lO00lO0 )THEN BEGIN DSTREAM ^. SEEK (O101l00l1Ol10 );DSTREAM ^. READ (OOlIlOl0l0l1 , SIZEOF
  473. (OOI11lO00lO0 ));CASE OOlIlOl0l0l1.OlOO1OI0I1  OF $5A4D :BEGIN DSTREAM ^. READ (O10110OOOl1ll , SIZEOF (O10110ll11II1 ));
  474. IF O10110OOOl1ll.O1l11I0OlO >= $40 THEN O101l00l1Ol10 := O10110OOOl1ll.O10111011IIll ELSE INC (O101l00l1Ol10 , LONGMUL
  475. (OOlIlOl0l0l1.O1010l0O10O11 , 512 )- (- OOlIlOl0l0l1.O101O1O1l00l1 AND 511 ));OIOOlO1I0l1 := FALSE ;END ;$454E
  476. :BEGIN O101l00l1Ol10 := DSTREAM ^. GETSIZE - 8 ;OIOOlO1I0l1 := FALSE ;END ;$4246 :BEGIN OIOOlO1I0l1 := FALSE ;
  477. CASE OOlIlOl0l0l1.OOIlO11O1100  OF $5250 :BEGIN HALT (1 );OIOIOOI0OO1 := TRUE ;OIOOlO1I0l1 := TRUE ;END ;$4C42 :DEC
  478. (O101l00l1Ol10 , OOlIlOl0l0l1.OOO0O110l0OI - 8 );$4648 :DEC (O101l00l1Ol10 , SIZEOF (OOI11lO00lO0 )* 2 );ELSE OIOOlO1I0l1
  479. := TRUE ;END ;END ;$424E :IF OOlIlOl0l0l1.OOIlO11O1100 =$3230 THEN BEGIN DEC (O101l00l1Ol10 , OOlIlOl0l0l1.OOO0O110l0OI
  480. );INC (O101l00l1Ol10 , 16 + 8 );OIOIOOI0OO1 := TRUE ;OIOOlO1I0l1 := TRUE ;END ;$52FB :BEGIN OIOOlO1I0l1 := TRUE ;
  481. OIOIOOI0OO1 := TRUE ;END ;$4246 :IF OOlIlOl0l0l1.OOIlO11O1100 =$5250 THEN HALT (1 )ELSE BEGIN INC (O101l00l1Ol10 ,
  482. OOlIlOl0l0l1.OOO0O110l0OI + 8 );OIOOlO1I0l1 := FALSE ;END ;END ;END ;UNTIL OIOOlO1I0l1 ;IF OIOIOOI0OO1 THEN
  483. BEGIN DEBUGINFOSTART := O101l00l1Ol10 ;DSTREAM ^. SEEK (DEBUGINFOSTART );FILLCHAR (DEBUGHEADER , SIZEOF (TDEBUGHEADER ),
  484. 0 );DSTREAM ^. READ (DEBUGHEADER , SMALLDEBUGHEADERSIZE );IF DEBUGHEADER.EXTENSIONSIZE <> 0 THEN DSTREAM ^. READ
  485. (DEBUGHEADER.CLASSENTRIES , DEBUGHEADER.EXTENSIONSIZE );SYMBOLSOFFSET := DSTREAM ^. GETPOS ;
  486. WITH DEBUGHEADER DO BEGIN MODULESOFFSET := SYMBOLSOFFSET + LONGINT (SYMBOLSCOUNT )* SYMBOLRECORDSIZE ;SOURCEFILESOFFSET
  487. := MODULESOFFSET + LONGINT (MODULESCOUNT )* MODULERECORDSIZE ;LINENUMBERSOFFSET := SOURCEFILESOFFSET + LONGINT
  488. (SOURCEFILESCOUNT )* SOURCEFILERECORDSIZE ;SCOPESOFFSET := LINENUMBERSOFFSET + LONGINT (LINENUMBERSCOUNT )*
  489. LINENUMBERRECORDSIZE ;SEGMENTSOFFSET := SCOPESOFFSET + LONGINT (SCOPESCOUNT )* SCOPERECORDSIZE ;CORRELATIONSOFFSET :=
  490. SEGMENTSOFFSET + LONGINT (SEGMENTSCOUNT )* SEGMENTRECORDSIZE ;TYPESOFFSET := CORRELATIONSOFFSET + LONGINT
  491. (CORRELATIONSCOUNT )* CORRELATIONRECORDSIZE ;MEMBERSOFFSET := TYPESOFFSET + LONGINT (TYPESCOUNT )* TYPERECORDSIZE ;
  492. CLASSESOFFSET := MEMBERSOFFSET + LONGINT (MEMBERSCOUNT )* MEMBERRECORDSIZE ;PARENTSOFFSET := CLASSESOFFSET + LONGINT
  493. (CLASSENTRIES )* CLASSRECORDSIZE ;SCOPECLASSESOFFSET := PARENTSOFFSET + LONGINT (PARENTENTRIES )* PARENTRECORDSIZE +
  494. LONGINT (OVERLOADENTRIES )* OVERLOADRECORDSIZE ;MODULECLASSESOFFSET := SCOPECLASSESOFFSET + LONGINT (SCOPECLASSENTRIES )*
  495. SCOPECLASSRECORDSIZE ;BROWSERSOFFSET := MODULECLASSESOFFSET + LONGINT (MODULECLASSENTRIES )* MODULECLASSRECORDSIZE ;
  496. DATAOFFSET := BROWSERSOFFSET + LONGINT (BROWSERSCOUNT )* BROWSERRECORDSIZE ;NAMESOFFSET := DATAOFFSET + DATACOUNT ;
  497. OIOIOOI0OO1 := O1OO1I1Il00l ;END ;END ;IF OIOIOOI0OO1 THEN O10O01011010O := PRESENT ELSE O10O01011010O := NOTPRESENT ;
  498. TDINFOPRESENT := OIOIOOI0OO1 ;END ;CONSTRUCTOR TSYMBOL.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;
  499. DESTRUCTOR TSYMBOL.DONE ;BEGIN DISCARD (MODULEPTR );DISCARD (SCOPEPTR );DISCARD (TYPEPTR );INHERITED DONE;END ;
  500. CONSTRUCTOR TSYMBOL.ATADDR (ADDR:POINTER);FUNCTION O1Ol1OO1lOIl (OI11l0OIll00:PSCOPE):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl :=
  501. (OI11l0OIll00 ^. OFFSET <= PTRREC (ADDR ). OFS )AND (OI11l0OIll00 ^. OFFSET + OI11l0OIll00 ^. LENGTH >= PTRREC (ADDR ).
  502. OFS );END ;VAR O1010l00IOO11:PSEGMENT;OI11l0OIll00:PSCOPE;OIlO:INTEGER;BEGIN INHERITED INIT;NEW (O1010l00IOO11 , ATADDR
  503. (ADDR ));IF O1010l00IOO11 =NIL THEN FAIL ;OI11l0OIll00 := O1010l00IOO11 ^. FIRSTSCOPETHAT (@ O1Ol1OO1lOIl );IF
  504. OI11l0OIll00 =NIL THEN BEGIN DISPOSE (O1010l00IOO11 , DONE );FAIL ;END ;IF (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FFFF )OR
  505. (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FEEE )THEN FAIL ;GET (OI11l0OIll00 ^. FUNCTIONSYMBOL );SCOPEPTR := OI11l0OIll00 ;
  506. DISPOSE (O1010l00IOO11 , DONE );END ;CONSTRUCTOR TSYMBOL.ATSEGMENT (ASEGMENT:PSEGMENT;ADDR:POINTER);
  507. FUNCTION O1Ol1OO1lOIl (OI11l0OIll00:PSCOPE):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl := (OI11l0OIll00 ^. OFFSET <= PTRREC (ADDR ).
  508. OFS )AND (OI11l0OIll00 ^. OFFSET + OI11l0OIll00 ^. LENGTH >= PTRREC (ADDR ). OFS );END ;VAR OI11l0OIll00:PSCOPE;
  509. OIlO:INTEGER;BEGIN INHERITED INIT;OI11l0OIll00 := ASEGMENT ^. FIRSTSCOPETHAT (@ O1Ol1OO1lOIl );IF OI11l0OIll00 =NIL THEN
  510. FAIL ;IF (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FFFF )OR (OI11l0OIll00 ^. FUNCTIONSYMBOL =$FEEE )THEN FAIL ;GET (OI11l0OIll00
  511. ^. FUNCTIONSYMBOL );SCOPEPTR := OI11l0OIll00 ;END ;PROCEDURE TSYMBOL.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^.
  512. SEEK (SYMBOLSOFFSET + (INDEX - 1 )* SYMBOLRECORDSIZE );DSTREAM ^. READ (NAME , SYMBOLRECORDSIZE );END ;
  513. FUNCTION TSYMBOL.CLASS :WORD ;BEGIN CLASS := (INFO AND $7 );END ;FUNCTION TSYMBOL.HASVALIDBP :BOOLEAN ;BEGIN HASVALIDBP
  514. := (INFO AND $10 )<> 0 END ;FUNCTION TSYMBOL.RETURNADDRESSWORDOFFSET :WORD ;BEGIN RETURNADDRESSWORDOFFSET := (INFO AND
  515. $E0 )SHR 5 ;END ;FUNCTION TSYMBOL.ITSMODULE :PMODULE ;BEGIN IF MODULEPTR =NIL THEN ABSTRACT ;ITSMODULE := MODULEPTR ;
  516. END ;FUNCTION TSYMBOL.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );END ;FUNCTION TSYMBOL.ITSSCOPE :PSCOPE ;
  517. BEGIN IF SCOPEPTR =NIL THEN ABSTRACT ;ITSSCOPE := SCOPEPTR ;END ;FUNCTION TSYMBOL.ITSTYPE :PTYPE ;BEGIN IF (TYPEPTR =NIL
  518. )AND (TYPEINDEX <> TID_VOID )THEN NEW (TYPEPTR , INIT (TYPEINDEX ));ITSTYPE := TYPEPTR ;END ;
  519. FUNCTION TSYMBOL.ITSVALUESTR (STACKFRAME:WORD):STRING ;VAR OOlIl0OOIIOO:POINTER;BEGIN IF TYPEINDEX =TID_VOID THEN
  520. BEGIN ITSVALUESTR := '';EXIT ;END ;CASE CLASS  OF SCSTATIC :OOlIl0OOIIOO := PTR (DSEG , OFFSET );SCABSOLUTE :OOlIl0OOIIOO
  521. := PTR (SEGMENT , OFFSET );SCLOCAL :OOlIl0OOIIOO := PTR (SSEG , STACKFRAME + OFFSET );SCPASVAR :OOlIl0OOIIOO := POINTER
  522. (PTR (SSEG , STACKFRAME + OFFSET )^);ELSE LOGERROR ('Not yet supported class: $'+ HEXSTR (CLASS )+
  523. ' -- TSymbol.ItsValueStr--');END ;IF OOlIl0OOIIOO =NIL THEN ITSVALUESTR := '!!'+ ITSNAME + ' = nil!!'ELSE ITSVALUESTR :=
  524. ITSTYPE ^. ITSVALUESTR (OOlIl0OOIIOO );END ;FUNCTION TSYMBOL.ISPROCEDURE :BOOLEAN ;BEGIN ISPROCEDURE := ITSTYPE ^. ID IN
  525. [ TID_FUNCTION , TID_FUNCPROTOTYPE , TID_SPECIALFUNC ] END ;CONSTRUCTOR TMODULE.INIT (AINDEX:WORD);VAR OOII:WORD;
  526. OI11l0OIll00:PSCOPE;BEGIN INHERITED INIT;GET (AINDEX );NEW (OI11l0OIll00 , INIT (AINDEX ));SYMBOLINDEX := OI11l0OIll00 ^.
  527. SYMBOLINDEX ;SYMBOLCOUNT := OI11l0OIll00 ^. SYMBOLCOUNT ;DISPOSE (OI11l0OIll00 , DONE );END ;PROCEDURE TMODULE.GET
  528. (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (MODULESOFFSET + (INDEX - 1 )* MODULERECORDSIZE );DSTREAM ^. READ
  529. (NAME , MODULERECORDSIZE );END ;FUNCTION TMODULE.MEMORYMODEL :WORD ;BEGIN MEMORYMODEL := FLAGS AND $E ;END ;
  530. FUNCTION TMODULE.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );END ;PROCEDURE TMODULE.FOREACHDSEGELEMENT
  531. (ACTION:POINTER);VAR OIlO:WORD;OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO := SYMBOLINDEX TO SYMBOLINDEX + SYMBOLCOUNT - 1
  532.  DO BEGIN NEW (OIOOO0O0I1l , INIT (OIlO ));IF (OIOOO0O0I1l <> NIL )AND (OIOOO0O0I1l ^. CLASS =SCSTATIC )AND ((OIOOO0O0I1l
  533. ^. ITSTYPE =NIL )OR NOT (OIOOO0O0I1l ^. ITSTYPE ^. ID IN [ TID_FUNCTION , TID_SPECIALFUNC ] ))THEN BEGIN ASM {}
  534. LES DI , OIOOO0O0I1l{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {} PUSH AX {}
  535. {$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{} END;END ;DISCARD (OIOOO0O0I1l );END ;END ;
  536. CONSTRUCTOR TSOURCEFILE.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;PROCEDURE TSOURCEFILE.GET
  537. (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (SOURCEFILESOFFSET + (INDEX - 1 )* SOURCEFILERECORDSIZE );DSTREAM ^.
  538. READ (NAME , SOURCEFILERECORDSIZE );END ;FUNCTION TSOURCEFILE.ITSNAME :STRING ;BEGIN ITSNAME := NAMES ^. GETNAME (NAME );
  539. END ;CONSTRUCTOR TLINENUMBER.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TLINENUMBER.DONE ;
  540. BEGIN DISCARD (CORRELATIONPTR );INHERITED DONE;END ;CONSTRUCTOR TLINENUMBER.ATADDR (ADDR:POINTER);VAR OIIl0OO0Il:WORD;
  541. FUNCTION O1Ol1OO1lOIl (O10OIIOl11lI1:PCORRELATION):BOOLEAN ;FAR;BEGIN O1Ol1OO1lOIl := O10OIIOl11lI1 ^.
  542. SEARCHLINENUMBEROFFSET (PTRREC (ADDR ). OFS , OIIl0OO0Il );END ;VAR OI0011l0I1:PSEGMENT;O10OIIOl11lI1:PCORRELATION;
  543. BEGIN INHERITED INIT;NEW (OI0011l0I1 , ATADDR (ADDR ));IF (OI0011l0I1 =NIL )OR (OI0011l0I1 ^. CORRELATIONCOUNT =0 )THEN
  544. BEGIN DISCARD (OI0011l0I1 );FAIL ;END ;O10OIIOl11lI1 := OI0011l0I1 ^. FIRSTCORRELATIONTHAT (@ O1Ol1OO1lOIl );IF
  545. O10OIIOl11lI1 =NIL THEN FAIL ;GET (OIIl0OO0Il );CORRELATIONPTR := O10OIIOl11lI1 ;DISPOSE (OI0011l0I1 , DONE );END ;
  546. PROCEDURE TLINENUMBER.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (LINENUMBERSOFFSET + (INDEX - 1 )*
  547. LINENUMBERRECORDSIZE );DSTREAM ^. READ (VALUE , LINENUMBERRECORDSIZE );END ;FUNCTION TLINENUMBER.ITSCORRELATION
  548. :PCORRELATION ;BEGIN IF CORRELATIONPTR =NIL THEN ABSTRACT ;ITSCORRELATION := CORRELATIONPTR ;END ;
  549. CONSTRUCTOR TSCOPE.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;PROCEDURE TSCOPE.GET (AINDEX:WORD);
  550. BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (SCOPESOFFSET + (INDEX - 1 )* SCOPERECORDSIZE );DSTREAM ^. READ (SYMBOLINDEX ,
  551. SCOPERECORDSIZE );END ;PROCEDURE TSCOPE.FOREACH (ACTION:POINTER);VAR OIlO:INTEGER;OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO :=
  552. SYMBOLINDEX TO SYMBOLINDEX + SYMBOLCOUNT - 1  DO BEGIN NEW (OIOOO0O0I1l , INIT (OIlO ));ASM {} LES DI , OIOOO0O0I1l{}
  553. PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {} PUSH AX {} {$ELSE} {}
  554. PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{} END;DISPOSE (OIOOO0O0I1l , DONE );END ;END ;
  555. PROCEDURE TSCOPE.FOREACHPARAMETER (ACTION:POINTER);VAR OIlO:INTEGER;OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO := SYMBOLINDEX TO
  556. SYMBOLINDEX + SYMBOLCOUNT - 1  DO BEGIN NEW (OIOOO0O0I1l , INIT (OIlO ));IF (OIOOO0O0I1l ^. CLASS IN [ SCLOCAL , SCPASVAR
  557. ] )AND (OIOOO0O0I1l ^. INFO AND $08 <> 0 )THEN ASM {} LES DI , OIOOO0O0I1l{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {}
  558. MOV AX , [ BP ] {} AND AL , 0feh {} PUSH AX {} {$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{}
  559. END;DISPOSE (OIOOO0O0I1l , DONE );END ;END ;PROCEDURE TSCOPE.FOREACHLOCAL (ACTION:POINTER);VAR OIlO:INTEGER;
  560. OIOOO0O0I1l:PSYMBOL;BEGIN FOR OIlO := SYMBOLINDEX TO SYMBOLINDEX + SYMBOLCOUNT - 1  DO BEGIN NEW (OIOOO0O0I1l , INIT
  561. (OIlO ));IF (OIOOO0O0I1l ^. CLASS IN [ SCLOCAL ] )AND (OIOOO0O0I1l ^. INFO AND $08 =0 )THEN ASM {} LES DI , OIOOO0O0I1l{}
  562. PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {} PUSH AX {} {$ELSE} {}
  563. PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{} END;DISPOSE (OIOOO0O0I1l , DONE );END ;END ;
  564. CONSTRUCTOR TSEGMENT.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TSEGMENT.DONE ;BEGIN DISCARD
  565. (MODULEPTR );INHERITED DONE;END ;CONSTRUCTOR TSEGMENT.ATADDR (ADDR:POINTER);VAR {$IFDEF MSDOS}OO0I,OO0O,OO00:WORD;
  566. {$ELSE}OIlO:WORD;{$ENDIF}BEGIN INHERITED INIT;{$IFDEF MSDOS}OO0I := 1 ;OO0O := DEBUGHEADER.SEGMENTSCOUNT ;WHILE OO0I <=
  567. OO0O  DO BEGIN OO00 := OO0I + (OO0O - OO0I )DIV 2 ;GET (OO00 );IF (CODESEGMENT =PTRREC (ADDR ). SEG )AND (CODEOFFSET <=
  568. PTRREC (ADDR ). OFS )AND (CODEOFFSET + CODELENGTH >= PTRREC (ADDR ). OFS )THEN EXIT ELSE IF (CODESEGMENT > PTRREC (ADDR
  569. ). SEG )OR ((CODESEGMENT =PTRREC (ADDR ). SEG )AND (CODEOFFSET + CODELENGTH >= PTRREC (ADDR ). OFS ))THEN OO0O := OO00 -
  570. 1 ELSE OO0I := OO00 + 1 END ;FAIL ;{$ELSE}FOR OIlO := 1 TO DEBUGHEADER.SEGMENTSCOUNT  DO BEGIN GET (OIlO );IF
  571. (CODESEGMENT =PTRREC (ADDR ). SEG )AND (CODEOFFSET <= PTRREC (ADDR ). OFS )AND (CODEOFFSET + CODELENGTH >= PTRREC (ADDR
  572. ). OFS )THEN EXIT ;END ;FAIL ;{$ENDIF}END ;PROCEDURE TSEGMENT.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK
  573. (SEGMENTSOFFSET + (INDEX - 1 )* SEGMENTRECORDSIZE );DSTREAM ^. READ (MODULEINDEX , SEGMENTRECORDSIZE );END ;
  574. FUNCTION TSEGMENT.ITSMODULE :PMODULE ;BEGIN IF MODULEPTR =NIL THEN NEW (MODULEPTR , INIT (MODULEINDEX ));ITSMODULE :=
  575. MODULEPTR ;END ;FUNCTION TSEGMENT.FIRSTCORRELATIONTHAT (TEST:POINTER):PCORRELATION ;VAR O10OIIOl11lI1:PCORRELATION;
  576. OIOIOOI0OO1:BOOLEAN;OIlO:INTEGER;BEGIN FOR OIlO := 0 TO CORRELATIONCOUNT - 1  DO BEGIN NEW (O10OIIOl11lI1 , INIT
  577. (CORRELATIONINDEX + OIlO ));ASM {} LES DI , O10OIIOl11lI1{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {}
  578. AND AL , 0feh {} PUSH AX {} {$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR TEST {} MOV OIOIOOI0OO1, AL {}
  579. END;IF OIOIOOI0OO1 THEN BEGIN FIRSTCORRELATIONTHAT := O10OIIOl11lI1 ;EXIT ;END ELSE DISCARD (O10OIIOl11lI1 );END ;
  580. FIRSTCORRELATIONTHAT := NIL ;END ;FUNCTION TSEGMENT.FIRSTSCOPETHAT (TEST:POINTER):PSCOPE ;VAR OI11l0OIll00:PSCOPE;
  581. OIOIOOI0OO1:BOOLEAN;OIlO:INTEGER;BEGIN FOR OIlO := 0 TO SCOPECOUNT - 1  DO BEGIN NEW (OI11l0OIll00 , INIT (SCOPEINDEX +
  582. OIlO ));ASM {} LES DI , OI11l0OIll00{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {}
  583. PUSH AX {} {$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR TEST {} MOV OIOIOOI0OO1, AL {} END;IF
  584. OIOIOOI0OO1 THEN BEGIN FIRSTSCOPETHAT := OI11l0OIll00 ;EXIT ;END ELSE DISCARD (OI11l0OIll00 );END ;FIRSTSCOPETHAT := NIL
  585. ;END ;CONSTRUCTOR TCORRELATION.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TCORRELATION.DONE ;
  586. BEGIN DISCARD (SEGMENTPTR );DISCARD (SOURCEFILEPTR );INHERITED DONE;END ;PROCEDURE TCORRELATION.GET (AINDEX:WORD);
  587. BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (CORRELATIONSOFFSET + (INDEX - 1 )* CORRELATIONRECORDSIZE );DSTREAM ^. READ
  588. (SEGMENTINDEX , CORRELATIONRECORDSIZE );END ;FUNCTION TCORRELATION.ITSMODULE :PMODULE ;BEGIN ITSMODULE := ITSSEGMENT ^.
  589. ITSMODULE ;END ;FUNCTION TCORRELATION.ITSSEGMENT :PSEGMENT ;BEGIN IF SEGMENTPTR =NIL THEN NEW (SEGMENTPTR , INIT
  590. (SEGMENTINDEX ));ITSSEGMENT := SEGMENTPTR ;END ;FUNCTION TCORRELATION.ITSSOURCEFILE :PSOURCEFILE ;BEGIN IF SOURCEFILEPTR
  591. =NIL THEN NEW (SOURCEFILEPTR , INIT (SOURCEFILEINDEX ));ITSSOURCEFILE := SOURCEFILEPTR ;END ;
  592. FUNCTION TCORRELATION.SEARCHLINENUMBEROFFSET (OFFSET:WORD;VAR AINDEX:WORD):BOOLEAN ;VAR OO01:TLINENUMBER;OIlO:INTEGER;
  593. BEGIN SEARCHLINENUMBEROFFSET := FALSE ;DSTREAM ^. SEEK (LINENUMBERSOFFSET + LINENUMBERINDEX * LINENUMBERRECORDSIZE );
  594. SEARCHLINENUMBEROFFSET := FALSE ;FOR OIlO := 0 TO LINENUMBERCOUNT - 1  DO BEGIN DSTREAM ^. READ (OO01.VALUE ,
  595. LINENUMBERRECORDSIZE );IF OO01.OFFSET =OFFSET THEN BEGIN SEARCHLINENUMBEROFFSET := TRUE ;AINDEX := LINENUMBERINDEX + OIlO
  596. + 1 ;EXIT ;END ;IF OO01.OFFSET > OFFSET THEN BEGIN IF OIlO > 0 THEN AINDEX := LINENUMBERINDEX + OIlO ELSE AINDEX :=
  597. LINENUMBERINDEX + OIlO + 1 ;SEARCHLINENUMBEROFFSET := TRUE ;EXIT ;END ;END ;END ;CONSTRUCTOR TTYPE.INIT (AINDEX:WORD);
  598. BEGIN IF AINDEX =0 THEN FAIL ;INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TTYPE.DONE ;BEGIN DISCARD (CLASSTYPEPTR );
  599. DISCARD (RETURNTYPEPTR );DISCARD (MEMBERPTR );INHERITED DONE;END ;FUNCTION TTYPE.MAX_SIZE :BYTE ;BEGIN MAX_SIZE := FILLER
  600. [ 1 ] ;END ;FUNCTION TTYPE.ENUM_PARENT :WORD ;VAR OOII:WORD;BEGIN MOVE (FILLER [ 2 ] , OOII , SIZEOF (OOII ));
  601. ENUM_PARENT := OOII ;END ;FUNCTION TTYPE.ENUM_LOWER :WORD ;VAR OOII:WORD;BEGIN MOVE (FILLER [ 4 ] , OOII , SIZEOF (OOII
  602. ));ENUM_LOWER := OOII ;END ;FUNCTION TTYPE.ENUM_UPPER :WORD ;VAR OOII:WORD;BEGIN MOVE (FILLER [ 6 ] , OOII , SIZEOF (OOII
  603. ));ENUM_UPPER := OOII ;END ;FUNCTION TTYPE.ENUM_MEMBERS :WORD ;VAR OOII:WORD;BEGIN MOVE (FILLER [ 8 ] , OOII , SIZEOF
  604. (OOII ));ENUM_MEMBERS := OOII ;END ;PROCEDURE TTYPE.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (TYPESOFFSET
  605. + (INDEX - 1 )* TYPERECORDSIZE );DSTREAM ^. READ (ID , TYPERECORDSIZE );IF ID IN [ TID_SCHAR .. TID_PCHAR , TID_ENUM ,
  606. TID_BOOL , TID_PENUM , TID_FUNCPROTOTYPE , TID_SPECIALFUNC ] THEN DSTREAM ^. READ (FILLER [ 4 ] , TYPERECORDSIZE );END ;
  607. FUNCTION TTYPE.ITSCLASSTYPE :PTYPE ;VAR OII0IOOII01:WORD;BEGIN IF CLASSTYPEPTR =NIL THEN BEGIN MOVE (FILLER [ 4 ] ,
  608. OII0IOOII01 , SIZEOF (OII0IOOII01 ));NEW (CLASSTYPEPTR , INIT (OII0IOOII01 ));END ;ITSCLASSTYPE := CLASSTYPEPTR ;END ;
  609. FUNCTION TTYPE.ITSNAME :STRING ;BEGIN IF ID =TID_PSTR THEN ITSNAME := 'string['+ STRW (MAX_SIZE )+ ']'ELSE ITSNAME :=
  610. NAMES ^. GETNAME (NAME );END ;FUNCTION TTYPE.ITSRETURNTYPE :PTYPE ;BEGIN IF RETURNTYPEPTR =NIL THEN NEW (RETURNTYPEPTR ,
  611. INIT (RETURNTYPE ));ITSRETURNTYPE := RETURNTYPEPTR ;END ;FUNCTION TTYPE.ITSVALUESTR (ADDR:POINTER):STRING ;
  612. VAR OO1O:STRING ;OIOl01Il1I1:POINTER;PROCEDURE OOlIllllIIIO (OOlIlOlO11lO:PMEMBER);FAR;BEGIN IF OOlIlOlO11lO ^. INFO IN [
  613. 0 , $80 ] THEN BEGIN IF OO1O =''THEN OO1O := OOlIlOlO11lO ^. ITSTYPE ^. ITSVALUESTR (OIOl01Il1I1 )ELSE OO1O := OO1O +
  614. ','+ OOlIlOlO11lO ^. ITSTYPE ^. ITSVALUESTR (OIOl01Il1I1 );INC (PTRREC (OIOl01Il1I1 ). OFS , OOlIlOlO11lO ^. ITSTYPE ^.
  615. SIZE );END ;END ;BEGIN IF (ADDR =NIL )OR NOT ISVALIDPTR (ADDR )THEN BEGIN ITSVALUESTR := '<invalid addr>';EXIT ;END ;
  616. CASE ID  OF TID_VOID , TID_FAR :ITSVALUESTR := 'Ptr($'+ HEXSTR (PTRREC (POINTER (ADDR ^)). SEG )+ ',$'+ HEXSTR (PTRREC
  617. (POINTER (ADDR ^)). OFS )+ ')';TID_PSTR :ITSVALUESTR := #39+ PSTRING (ADDR )^+ #39;TID_SCHAR :ITSVALUESTR := STRS
  618. (SHORTINT (ADDR ^));TID_SINT :ITSVALUESTR := STRI (INTEGER (ADDR ^));TID_SLONG :ITSVALUESTR := STRL (LONGINT (ADDR ^));
  619. TID_UCHAR :ITSVALUESTR := STRB (BYTE (ADDR ^));TID_UINT :ITSVALUESTR := STRW (WORD (ADDR ^));TID_FLOAT :BEGIN STR (SINGLE
  620. (ADDR ^), OO1O );ITSVALUESTR := OO1O ;END ;TID_TPREAL :BEGIN STR (REAL (ADDR ^), OO1O );ITSVALUESTR := OO1O ;END ;
  621. TID_STRUCT :ITSVALUESTR := 'struct '+ ITSNAME ;TID_TFILE :BEGIN OO1O := '(';CASE TEXTREC (ADDR ^). MODE  OF FMCLOSED
  622. :OO1O := OO1O + 'Closed';FMINOUT :OO1O := OO1O + 'InOut';FMINPUT :OO1O := OO1O + 'Input';FMOUTPUT :OO1O := OO1O +
  623. 'Output';ELSE OO1O := OO1O + '??';END ;ITSVALUESTR := OO1O + ','#39+ GETTEXTFILENAME (TEXT (ADDR ^))+ #39')';END ;
  624. TID_BFILE :BEGIN OO1O := '(';CASE FILEREC (ADDR ^). MODE  OF FMCLOSED :OO1O := OO1O + 'Closed';ELSE OO1O := OO1O +
  625. 'Open';END ;ITSVALUESTR := OO1O + ','#39+ GETFILENAME (FILE (ADDR ^))+ #39')';END ;TID_BOOL :IF BOOLEAN (ADDR ^)THEN
  626. ITSVALUESTR := 'TRUE'ELSE ITSVALUESTR := 'FALSE';TID_PENUM :BEGIN ITSVALUESTR := MEMBER (BYTE (ADDR ^))^. ITSNAME ;END ;
  627. TID_OBJECT :BEGIN OO1O := '';OIOl01Il1I1 := ADDR ;INC (PTRREC (OIOl01Il1I1 ). OFS , 2 );ITSOBJECT ^. FOREACHMEMBER (@
  628. OOlIllllIIIO );ITSVALUESTR := '('+ OO1O + ')';END ;ELSE BEGIN ITSVALUESTR := '??'+ ITSNAME + ' (Type ID = '+ HEXSTR (ID
  629. )+ ')??';END ;END ;END ;FUNCTION TTYPE.MEMBER (MEMBERINDEX:WORD):PMEMBER ;BEGIN DISCARD (MEMBERPTR );MEMBERPTR := NEW
  630. (PMEMBER , INIT (ENUM_MEMBERS + MEMBERINDEX ));MEMBER := MEMBERPTR ;END ;FUNCTION TTYPE.ITSOBJECT :PCLASS ;
  631. VAR OOII:WORD;BEGIN MOVE (FILLER [ 2 ] , OOII , SIZEOF (OOII ));ITSOBJECT := NEW (PCLASS , INIT (OOII ));END ;
  632. FUNCTION TTYPE.RETURNTYPE :WORD ;ASSEMBLER;ASM {} LES DI , [ BP + 6 ] {} MOV AX , WORD PTR ES : [ DI + 2 + 6 ] {} END;
  633. CONSTRUCTOR TMEMBER.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );END ;DESTRUCTOR TMEMBER.DONE ;BEGIN DISCARD
  634. (ITSTYPEPTR );INHERITED DONE;END ;FUNCTION TMEMBER.ENDOFSTRUCTURE :BOOLEAN ;BEGIN ENDOFSTRUCTURE := (INFO AND $80 )<> 0 ;
  635. END ;PROCEDURE TMEMBER.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (MEMBERSOFFSET + (INDEX - 1 )*
  636. MEMBERRECORDSIZE );DSTREAM ^. READ (INFO , MEMBERRECORDSIZE );END ;FUNCTION TMEMBER.ITSNAME :STRING ;BEGIN ITSNAME :=
  637. NAMES ^. GETNAME (NAME );END ;FUNCTION TMEMBER.ITSTYPE :PTYPE ;BEGIN IF ITSTYPEPTR =NIL THEN ITSTYPEPTR := NEW (PTYPE ,
  638. INIT (VALUE ));ITSTYPE := ITSTYPEPTR ;END ;CONSTRUCTOR TCLASS.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );
  639. END ;PROCEDURE TCLASS.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (CLASSESOFFSET + (INDEX - 1 )*
  640. CLASSRECORDSIZE );DSTREAM ^. READ (PARENTINDEX , CLASSRECORDSIZE );END ;FUNCTION TCLASS.ITSNAME :STRING ;BEGIN ITSNAME :=
  641. NAMES ^. GETNAME (NAME );END ;PROCEDURE TCLASS.FOREACHMEMBER (ACTION:POINTER);VAR OIlO:INTEGER;OOlIlOlO11lO:PMEMBER;
  642. BEGIN OOlIlOlO11lO := NIL ;OIlO := MEMBERINDEX ;REPEAT DISCARD (OOlIlOlO11lO );OOlIlOlO11lO := NEW (PMEMBER , INIT (OIlO
  643. ));ASM {} LES DI , OOlIlOlO11lO{} PUSH ES {} PUSH DI {} {$IFDEF Windows} {} MOV AX , [ BP ] {} AND AL , 0feh {}
  644. PUSH AX {} {$ELSE} {} PUSH WORD PTR [ BP ] {} {$ENDIF} {} CALL DWORD PTR ACTION{} END;INC (OIlO );UNTIL OOlIlOlO11lO ^.
  645. ENDOFSTRUCTURE ;DISCARD (OOlIlOlO11lO );END ;CONSTRUCTOR TBROWSER.INIT (AINDEX:WORD);BEGIN INHERITED INIT;GET (AINDEX );
  646. END ;PROCEDURE TBROWSER.GET (AINDEX:WORD);BEGIN INDEX := AINDEX ;DSTREAM ^. SEEK (BROWSERSOFFSET + (INDEX - 1 )*
  647. BROWSERRECORDSIZE );DSTREAM ^. READ (SYMBOLINDEX , BROWSERRECORDSIZE );END ;FUNCTION TBROWSER.ITSLINENUMBER :PLINENUMBER
  648. ;BEGIN IF LINENUMBERPTR =NIL THEN NEW (LINENUMBERPTR , INIT (LINENUMBERINDEX ));ITSLINENUMBER := LINENUMBERPTR ;END ;
  649. FUNCTION TBROWSER.ITSSOURCEFILE :PSOURCEFILE ;BEGIN IF SOURCEFILEPTR =NIL THEN NEW (SOURCEFILEPTR , INIT (SOURCEFILEINDEX
  650. ));ITSSOURCEFILE := SOURCEFILEPTR ;END ;FUNCTION TBROWSER.ITSSYMBOL :PSYMBOL ;BEGIN IF SYMBOLPTR =NIL THEN NEW (SYMBOLPTR
  651. , INIT (SYMBOLINDEX ));ITSSYMBOL := SYMBOLPTR ;END ;END .
  652.